home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / graphics / move4 / move.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-10-23  |  11.8 KB  |  280 lines
  1. VERSION 4.00
  2. Begin VB.Form WinStyles 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Windows Style Manipulations"
  6.    ClientHeight    =   6630
  7.    ClientLeft      =   1005
  8.    ClientTop       =   1545
  9.    ClientWidth     =   7365
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   7035
  21.    Icon            =   "MOVE.frx":0000
  22.    Left            =   945
  23.    LinkTopic       =   "Form1"
  24.    ScaleHeight     =   6630
  25.    ScaleWidth      =   7365
  26.    Top             =   1200
  27.    Width           =   7485
  28.    Begin VB.PictureBox Picture3 
  29.       Appearance      =   0  'Flat
  30.       BackColor       =   &H0000FFFF&
  31.       ForeColor       =   &H80000008&
  32.       Height          =   855
  33.       Left            =   480
  34.       ScaleHeight     =   825
  35.       ScaleWidth      =   2805
  36.       TabIndex        =   6
  37.       Top             =   5580
  38.       Width           =   2835
  39.    End
  40.    Begin VB.PictureBox Picture2 
  41.       Appearance      =   0  'Flat
  42.       AutoRedraw      =   -1  'True
  43.       BackColor       =   &H80000005&
  44.       ForeColor       =   &H80000008&
  45.       Height          =   855
  46.       Left            =   3960
  47.       ScaleHeight     =   825
  48.       ScaleWidth      =   2865
  49.       TabIndex        =   5
  50.       Top             =   5580
  51.       Width           =   2895
  52.    End
  53.    Begin VB.TextBox Text2 
  54.       Appearance      =   0  'Flat
  55.       Height          =   975
  56.       Left            =   3960
  57.       TabIndex        =   4
  58.       Text            =   "Text2"
  59.       Top             =   4500
  60.       Width           =   2895
  61.    End
  62.    Begin VB.CommandButton Command1 
  63.       Appearance      =   0  'Flat
  64.       BackColor       =   &H80000005&
  65.       Caption         =   "Push me !"
  66.       Height          =   975
  67.       Left            =   480
  68.       TabIndex        =   3
  69.       Top             =   4500
  70.       Width           =   2835
  71.    End
  72.    Begin VB.TextBox Text1 
  73.       Appearance      =   0  'Flat
  74.       Height          =   975
  75.       Left            =   480
  76.       TabIndex        =   2
  77.       Text            =   "Text1"
  78.       Top             =   3300
  79.       Width           =   6375
  80.    End
  81.    Begin VB.ListBox List1 
  82.       Appearance      =   0  'Flat
  83.       Height          =   2760
  84.       Left            =   3960
  85.       TabIndex        =   1
  86.       Top             =   360
  87.       Width           =   2895
  88.    End
  89.    Begin VB.PictureBox Picture1 
  90.       Appearance      =   0  'Flat
  91.       AutoRedraw      =   -1  'True
  92.       BackColor       =   &H80000005&
  93.       BeginProperty Font 
  94.          name            =   "MS Sans Serif"
  95.          charset         =   1
  96.          weight          =   400
  97.          size            =   8.25
  98.          underline       =   0   'False
  99.          italic          =   0   'False
  100.          strikethrough   =   0   'False
  101.       EndProperty
  102.       ForeColor       =   &H000000FF&
  103.       Height          =   2775
  104.       Left            =   480
  105.       Picture         =   "MOVE.frx":030A
  106.       ScaleHeight     =   2745
  107.       ScaleWidth      =   2865
  108.       TabIndex        =   0
  109.       Top             =   360
  110.       Width           =   2895
  111.    End
  112. Attribute VB_Name = "WinStyles"
  113. Attribute VB_Creatable = False
  114. Attribute VB_Exposed = False
  115. ' * You nneed the MOVE.BAS as well ! *
  116. Option Explicit
  117. Dim retInt%, retLng&
  118. Dim oldX%, oldY%
  119. Private Sub Command1_Click()
  120.     MsgBox "If you hold down Ctrl you can even move me !", 64, "Notice"
  121. End Sub
  122. Private Sub Command1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
  123. ' --> from VB3 used the Mouse_Move event !
  124.     ' this pice of code enables ANY concerned control to be moved freely --> even an entire form !
  125.     ReleaseCapture
  126.     retInt = SendMessage(Command1.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0&)
  127. End Sub
  128. Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer)
  129.     ' can be move when Ctrl in pressed !
  130.     If Shift = 2 Then Command1.DragMode = 1
  131. End Sub
  132. Private Sub Command1_KeyUp(KeyCode As Integer, Shift As Integer)
  133.     Command1.DragMode = 0
  134. End Sub
  135. Private Sub Form_Load()
  136.     SetControls
  137.     Show
  138.     ' after the form built we can insert a text now...
  139.     SetTexts
  140.     ' (BUT: it it will only be shown until... (!?) - Well!
  141. End Sub
  142. Private Sub List1_Click()
  143.     List1.Clear
  144.     For retInt = 1 To 20
  145.         List1.AddItem "Item #" & retInt
  146.     Next retInt
  147. End Sub
  148. Private Sub List1_GotFocus()
  149.     ShowFocus List1
  150. End Sub
  151. Private Sub List1_LostFocus()
  152.     ShowFocus List1
  153. End Sub
  154. Private Sub Picture1_GotFocus()
  155.     ShowFocus Picture1
  156. End Sub
  157. Private Sub Picture1_LostFocus()
  158.     ShowFocus Picture1
  159. End Sub
  160. Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  161.     ' this should only be possible for the LEFT mouse key as usual.
  162.     If Button <> 1 Then Exit Sub
  163.     ' this pice of code enables ANY concerned control to be moved freely --> even an entire form !
  164.     ReleaseCapture
  165.     retInt = SendMessage(Picture2.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0&)
  166. End Sub
  167. Private Sub Picture3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  168. If Button <> 1 Then Exit Sub
  169. Picture3.ZOrder
  170.     oldX = X
  171.     oldY = Y
  172. End Sub
  173. Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  174. If Button <> 1 Then Exit Sub
  175.     Picture3.Left = Picture3.Left + X - oldX
  176.     Picture3.TOP = Picture3.TOP + Y - oldY
  177. End Sub
  178. '                                                       '
  179. ' Here, all the setting are done.                       '
  180. ' *** WARNING ***                                       '
  181. ' This code was just put together for a demonstration.  '
  182. ' (YES, it was tested. THIS code is OK.)                '
  183. ' Please be careful with YOUR experiments !!!           '
  184. ' Noone will be responsible for your "results" !        '
  185. ' BUT: good results should be given to the public !     '
  186. '                                                       '
  187. Private Sub SetControls()
  188.     Dim Style&
  189.     Style = GetWindowLong(Picture1.hWnd, GWL_STYLE)             ' Obtain the actual style
  190.     Style = Style Or WS_THICKFRAME                              ' Give it a Sizable Frame
  191.     Style = Style Or WS_CAPTION                                 ' Give it a Caption
  192.     Style = Style Or WS_MINIMIZEBOX                             ' Give it a MinimizeBox
  193.     Style = Style Or WS_SYSMENU                                 ' Give it a System Menu
  194.     Style = SetWindowLong(Picture1.hWnd, GWL_STYLE, Style)      ' - pass the new style
  195.     Picture1.Height = Picture1.Height                           ' ! REBUILD THE CONTROL !
  196.     retInt = SetWindowText(Picture1.hWnd, "The Picture Box")    ' Give it a Name, too
  197.     Picture1.Height = Picture1.Height + 30                      ' ! REBUILD THE CONTROL !
  198.     Picture1.Height = Picture1.Height - 30                      ' the "extra kick" for VB4
  199.     Picture1.CurrentY = 700
  200.     Picture1.ForeColor = &HFF0000  ' [blue]
  201.     Picture1.Print " This is a demonstration."
  202.     Picture1.ForeColor = &H0&      ' [black]
  203.     Picture1.Print " Please";
  204.     Picture1.ForeColor = &HFF&     ' [red]
  205.     Picture1.Print " do not add";
  206.     Picture1.ForeColor = &H0&      ' [black]
  207.     Picture1.Print " system menus"
  208.     Picture1.Print " to controls like this here !"
  209.     Style = GetWindowLong(List1.hWnd, GWL_STYLE)                ' Obtain the actual style
  210.     Style = Style Or WS_THICKFRAME                              ' Give it a Dizable Frame
  211.     Style = Style Or WS_CAPTION                                 ' Give it a Caption
  212.     Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the MaximizeBox
  213.     Style = SetWindowLong(List1.hWnd, GWL_STYLE, Style)         ' - pass the new style
  214.     retInt = SetWindowText(List1.hWnd, "The List Box")          ' Give it a Name
  215.     List1.Height = List1.Height + 30                            ' ! REBUILD THE CONTROL !
  216.     List1.Height = List1.Height - 30                            ' the "extra kick" for VB4
  217.     List1.AddItem "Its nice and easy"
  218.     List1.AddItem "to manipulate controls"
  219.     List1.AddItem "this way !!!"
  220.     List1.AddItem "Come on, try it yourself !"
  221.     Style = GetWindowLong(Text1.hWnd, GWL_STYLE)                ' Obtain the actual style
  222.     Style = Style Or WS_BORDER                                  ' Give it a Thin Frame (--> you may leave this out)
  223.     Style = Style Or WS_CAPTION                                 ' Give it a Caption
  224.     Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the MaximizeBox
  225.     Style = SetWindowLong(Text1.hWnd, GWL_STYLE, Style)         ' - pass the new style
  226.     retInt = SetWindowText(Text1.hWnd, "The Text Box 1")          ' Give it a Name
  227.     ' same as: Text1 = "The Text Box"
  228.     ' NOTE: you can alter the text later.
  229.     Text1.Height = Text1.Height + 30                            ' ! REBUILD THE CONTROL !
  230.     Text1.Height = Text1.Height - 30                            ' ! REBUILD THE CONTROL !
  231.     Style = GetWindowLong(Command1.hWnd, GWL_STYLE)             ' Obtain the actual style
  232.     Style = Style Or WS_BORDER                                  ' Give it a border (--> don't leave this out)
  233.     Style = Style Or WS_THICKFRAME                              ' Give it a sizable frame
  234.     Style = SetWindowLong(Command1.hWnd, GWL_STYLE, Style)      ' - pass the new style
  235.     Command1.Height = Command1.Height                           ' ! REBUILD THE CONTROL !
  236.     Style = GetWindowLong(Text2.hWnd, GWL_STYLE)                ' Obtain the actual style
  237.     Style = Style Or WS_CAPTION                                 ' Give it a Caption
  238.     Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the Maximizebox
  239.     Style = SetWindowLong(Text2.hWnd, GWL_STYLE, Style)         ' - pass the new style
  240.     Style = GetWindowLong(Text2.hWnd, GWL_EXSTYLE)              ' Obtain the actual extended style
  241.     Style = Style Or WS_EX_DLGMODALFRAME                        ' Give it a Thick Border
  242.     Style = SetWindowLong(Text2.hWnd, GWL_EXSTYLE, Style)       ' - pass the new extended style
  243.     retInt = SetWindowText(Text2.hWnd, "The Text Box 2")
  244.     ' same as: Text2 = "The Text Box"
  245.     Text2.Height = Text2.Height + 30                            ' ! REBUILD THE CONTROL !
  246.     Text2.Height = Text2.Height - 30                            ' the "extra kick" for VB4
  247.     Picture2.CurrentX = 270
  248.     Picture2.CurrentY = 180
  249.     Picture2.Print "Step on me and move me !"
  250.     Dim Text$
  251.     Text = "(Don't be shy)"                                     ' center the text correctly
  252.     Picture2.CurrentX = (Picture2.ScaleWidth - Picture2.TextWidth(Text)) / 2
  253.     Picture2.ForeColor = &HFF0008   ' [= blue]
  254.     Picture2.Print Text
  255. End Sub
  256. Private Sub SetTexts()
  257.     Text1 = "Hi, I have no sizable border but a caption."
  258.     Text2 = "I have a fixed double border..."
  259. End Sub
  260. '                                                       '
  261. ' Well, we have to help VB a little...                  '
  262. '                                                       '
  263. Private Sub ShowFocus(Control As Control)
  264.     ' switches the active view of the caption on (and off !)
  265.     ' note: this a toggle function ; retInt receives the old value
  266.     retInt = FlashWindow(Control.hWnd, True)
  267. End Sub
  268. Private Sub Text1_GotFocus()
  269.     ShowFocus Text1
  270. End Sub
  271. Private Sub Text1_LostFocus()
  272.     ShowFocus Text1
  273. End Sub
  274. Private Sub Text2_GotFocus()
  275.     ShowFocus Text2
  276. End Sub
  277. Private Sub Text2_LostFocus()
  278.     ShowFocus Text2
  279. End Sub
  280.